home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / gnu_st.lha / gnu_st / smalltalk-1.1.1 / stix / GC.st < prev    next >
Text File  |  1991-09-12  |  5KB  |  183 lines
  1. "======================================================================
  2. |
  3. | Copyright (C) 1990, 1991 Free Software Foundation, Inc.
  4. | Written by Steve Byrne.
  5. |
  6. | This file is part of GNU Smalltalk.
  7. |
  8. | GNU Smalltalk is free software; you can redistribute it and/or modify it
  9. | under the terms of the GNU General Public License as published by the Free
  10. | Software Foundation; either version 1, or (at your option) any later version.
  11. | 
  12. | GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
  13. | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  14. | FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  15. | details.
  16. | 
  17. | You should have received a copy of the GNU General Public License along with
  18. | GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
  19. | Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  
  20. |
  21.  ======================================================================"
  22.  
  23.  
  24. "
  25. |     Change Log
  26. | ============================================================================
  27. | Author       Date       Change 
  28. | sbyrne     24 May 90      created.
  29. |
  30. "
  31.  
  32.  
  33.  
  34. !GC class methodsFor: 'instance creation'!
  35.  
  36. new: aDisplay drawable: aDrawable
  37.     ^super new init: aDisplay drawable: aDrawable
  38. !!
  39.  
  40. !GC methodsFor: 'X hacking'!
  41.  
  42. changeGC: aBlock
  43.     | packet gc |
  44.     
  45.     packet _ XGCAttrPacket command: 56.
  46.  
  47.     packet long: self id.
  48.     aBlock notNil
  49.     ifTrue: [ aBlock value: packet ]
  50.     ifFalse: [ packet noBits ].
  51.     display socket bytes: packet done.
  52. !
  53.  
  54. polyPoint: pointsVec coordMode: coordMode
  55.     | packet |
  56.     
  57.     packet _ XPacket command: 64 
  58.              aux: (X map: coordMode into: #(Origin Previous)).
  59.     packet long: drawable id; long: self id.
  60.     pointsVec do: [ :point | packet point: point ].
  61.     display socket bytes: packet done
  62. !    
  63.  
  64. polyLine: pointsVec coordMode: coordMode 
  65.     | packet |
  66.     
  67.     packet _ XPacket command: 65 
  68.              aux: (X map: coordMode into: #(Origin Previous)).
  69.     packet long: drawable id; long: self id.
  70.     pointsVec do: [ :point | packet point: point ].
  71.     display socket bytes: packet done
  72. !    
  73.  
  74. polyLine: aPoint to: otherPoint coordMode:  coordMode
  75.     | packet |
  76.     
  77.     self polyLine: (Array with: aPoint with: otherPoint) 
  78.       coordMode: coordMode
  79. !
  80.  
  81.  
  82. polySegment: segmentVec
  83.     | packet |
  84.  
  85.     packet _ XPacket command: 66. "segments are currently implemented using rectangles"
  86.     packet long: drawable id; long: self id.
  87.     segmentVec do: [ :seg | packet rectangle: seg ].
  88.     display socket bytes: packet done
  89. !
  90.  
  91.  
  92. polyRectangle: rectangleVec
  93.     | packet |    
  94.  
  95.     (rectangleVec isMemberOf: Rectangle) "ugh"
  96.     ifTrue: [ rectangleVec _ Array with: rectangleVec ].
  97.  
  98.     packet _ XPacket command: 67.
  99.     packet long: drawable id; long: self id.
  100.     rectangleVec do: [ :rect | packet point: rect origin.
  101.                    packet point: rect extent ].
  102.     display socket bytes: packet done
  103. !
  104.     
  105. polyArc: arcs
  106.     | packet |    
  107.  
  108.     packet _ XPacket command: 68.
  109.     packet long: drawable id; long: self id.
  110.     arcs do: [ :arc | packet arc: arc ].
  111.     display socket bytes: packet done
  112. !
  113.  
  114. "fillPoly"
  115.  
  116. polyFillRectangle: rectangles
  117.     | packet |
  118.  
  119.     packet _ XPacket command: 70.
  120.     packet long: drawable id; long: self id.
  121.     rectangles do: [ :rect | packet rectangle: rect ].
  122.     display socket bytes: packet done
  123. !    
  124.  
  125.  
  126. " ... "
  127.  
  128. polyText8: textItems x: x y: y
  129.     | packet |
  130.     
  131.     packet _ XPacket command: 74.
  132.     packet long: drawable id; long: self id; word: x; word: y.
  133.     textItems do: [ :textItem | packet textItem: textItem ].
  134.     display socket bytes: packet done
  135. !!
  136.  
  137.  
  138. !GC methodsFor: 'accessing'!
  139.  
  140. id
  141.     ^id
  142. !!
  143.  
  144. !GC methodsFor: 'example class'!
  145.  
  146.  
  147. drawExampleImage: button
  148.     self polyText8: (Array with: (TextItem onString: 'Welcome to ')
  149.              with: (TextItem onString: Version ))
  150.        x: 50 y: 30.
  151.  
  152.     self polyLine: 20@20 to: 40@40 coordMode: #Origin.
  153.     self polyLine: 40@20 to: 20@40 coordMode: #Origin.
  154.     
  155.     self polyRectangle: (Array with: (10 @ 10 corner: (400 - 20) @ (200 - 20))). 
  156.     self drawExampleButton: button.
  157. "    self polyFillRectangle: (Array with:  (10 @ 10 corner: 50 @ 50))."
  158.     self polyArc: (Array with: (Arc new: 10 @ 10 size: 40 @ 40 angles: (90*64) @ (180*64))).
  159.     self polyArc: (Array with: (Arc new: 10 @ 50 size: 40 @ 40 angles: (270*64) @ (180*64)))
  160. !
  161.  
  162.  
  163. drawExampleButton: button
  164.     | textStart |
  165.     self polyRectangle: (Array with: button). 
  166.     textStart _ button leftCenter.
  167.     self polyText8: (Array with: (TextItem onString: 'Click here to exit'))
  168.      x: textStart x + 10 y: textStart y
  169. !!
  170.  
  171.  
  172. !GC methodsFor: 'private'!
  173.  
  174. init: aDisplay drawable: aDrawable
  175.     display _ aDisplay.
  176.     drawable _ aDrawable.
  177.     id _ display nextId.
  178.     Registry at: id put: self
  179.     
  180. !!
  181.  
  182.  
  183.